MacFormat 1995 May/macformat-024.iso/Shareware City/Developers/TransSkel Pascal 2.5/TransSkel/MultiSkel ƒ/MSkelZoom.p

Text File | 1994-12-12 | 5.0 KB | 212 lines | [TEXT/PJMM]

{    TransSkel multiple-window demonstration: ZoomRect module}

{    This module handles a window in which successive randomly generated}
{    rectangles are smoothly interpolated into one another.  The display}
{    is white on black, which results in some interesting problems (see}
{    ZDrawGrowBox, for instance).  The display adjusts itself to the size}
{    of the window, so that the zoom series always lie entirely within}
{    the window.  Clicking the mouse in the window pauses the display until}
{    the button is released.}

{    14 June 1986        Paul DuBois}
{    7 January 1987    ported to LightSpeed Pascal by Owen Hartnett            }
{    Ωhm Software Company.                                                    }


unit MSkelZoom;

interface

    uses
{$IFC UNDEFINED THINK_PASCAL}
        Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf,
{$ENDC}
        MultiSkelGlobals, common, TransSkel;

    procedure ZoomWindInit;

implementation


    const
        zoomSteps = 15;        { # rects in interpolative series }

    var
        zRect: array[0..zoomSteps] of Rect;        { set of interpolated rectangles }
        zSrcRect: Rect;
        sizeX, sizeY: integer;                { size of window in pixels }

    procedure SetZoomSize;

        var
            r: Rect;

    begin
        r := zoomWind^.portRect;
        r.right := r.right - 15;                { don't use right edge }
        sizeX := r.right;
        sizeY := r.bottom;
    end;

{    return integer between zero and max (inclusive).  assumes max is}
{    non-negative.}

    function Rand (max: integer): integer;

        var
            t: integer;

    begin
        t := Random;
        if (t < 0) then
            t := -t;
        Rand := t mod (max + 1);
    end;

{    Interpolate one rectangle smoothly into another.  Erase the previous}
{    series as the new one is drawn.}

    procedure zoomRect (r1, r2: Rect);

        var
            r1left, r1top: integer;
            l, t: integer;
            j: integer;
            hDiff, vDiff, widDiff, htDiff: integer;
            r, b: integer;
            rWid, rHt: integer;

    begin
        r1left := r1.left;
        r1top := r1.top;
        hDiff := r2.left - r1left;        {positive if moving to right }
        vDiff := r2.top - r1top;        {positive if moving down        }

        rWid := r1.right - r1left;
        rHt := r1.bottom - r1top;
        widDiff := (r2.right - r2.left) - rWid;
        htDiff := (r2.bottom - r2.top) - rHt;

{    order of evaluation is important in the rect coordinate calculations.}
{    since all arithmetic is integer, you can't save time by calculating}
{    j/zoomSteps and using that - it'll usually be zero.}

        for j := 1 to zoomSteps do
            begin
                FrameRect(zRect[j - 1]);                { erase a rectangle }
                l := r1left + (hDiff * j) div zoomSteps;
                t := r1top + (vDiff * j) div zoomSteps;
                r := l + rWid + (widDiff * j) div zoomSteps;
                b := t + rHt + (htDiff * j) div zoomSteps;
                SetRect(zRect[j - 1], l, t, r, b);
                FrameRect(zRect[j - 1]);
            end;
    end;

    procedure Idle;

        var
            i: integer;
            pt1, pt2: Point;
            dstRect: Rect;

    begin
        SetPt(pt1, Rand(sizeX), Rand(sizeY));    { generate new rect }
        SetPt(pt2, Rand(sizeX), Rand(sizeY));    { and zoom to it        }
        Pt2Rect(pt1, pt2, dstRect);
        SetWindClip(zoomWind);            { don't draw in right edge }
        ZoomRect(zSrcRect, dstRect);
        ResetWindClip;
        zSrcRect := dstRect;
    end;

{    just pause zoom display while mouse down}

    procedure Mouse (thePt: point; t: longint; mods: integer);
    begin
        while (StillDown) do
            ;  { wait until mouse button released }
    end;

{    Draw the grow box in white on black.  This is tricky:  if the window}
{    is inactive, the grow box will be drawn black, as it should be.  But}
{    if the window is active, the box will STILL be drawn black on white!}
{    So have to check whether the window is active or not.  The test for}
{    active has to be done carefully:  the window manager stores 255 and 0}
{    for true and false, not real boolean values.}

    procedure ZDrawGrowBox;
        var
            r: Rect;
            zoomPeek: WindowPeek;

    begin
        PenMode(notPatCopy);
        DrawGrowBox(zoomWind);
        PenMode(patXor);
        zoomPeek := WindowPeek(zoomWind);
        if (zoomPeek^.hilited) then    { grow box draw in white }
            begin                        { no matter what if active }
                r := zoomWind^.portRect;                { - invert to fix }
                r.left := r.right - 14;
                r.top := r.bottom - 14;
                InvertRect(r);
            end;
    end;

    procedure Update (resized: Boolean);

        var
            i: integer;
    begin
        EraseRect(zoomWind^.portRect);
        ZDrawGrowBox;
        SetWindClip(zoomWind);
        for i := 0 to zoomSteps - 1 do
            FrameRect(zRect[i]);
        ResetWindClip;
        if resized then
            SetZoomSize;    { adjust to new window size }
    end;

    procedure Activate (active: Boolean);

    begin
        ZDrawGrowBox;
        if active then
            DisableItem(editMenu, 0)
        else
            EnableItem(editMenu, 0);
        DrawMenuBar;
    end;

    procedure Halt;
    begin
        CloseWindow(zoomWind);
    end;

    procedure ZoomWindInit;

        var
            i: integer;
    begin
        zoomWind := GetNewWindow(zoomWindRes, nil, WindowPtr(-1));
        dummy := SkelWindow(zoomWind, @Mouse, nil, @Update, @Activate, nil, @Halt, @Idle, true);
            { ignore key clicks }
            { no close proc }
        { when done with window }
        { draw a new series }
            { run only when frontmost }

        SetZoomSize;
{$IFC UNDEFINED THINK_PASCAL}
        BackPat(qd.black);
{$ELSEC}
        BackPat(black);
{$ENDC}
        PenMode(patXor);
        SetRect(zSrcRect, 0, 0, 0, 0);
        for i := 0 to zoomSteps - 1 do        { initialize rect array }
            zRect[i] := zSrcRect;
    end;
end.